home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Labels.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  1.8 KB  |  68 lines  |  [TEXT/R*ch]
  1. (* Handlings of local labels and backpatching *)
  2.  
  3. local 
  4.   open Fnlib Instruct Buffcode
  5. in
  6.  
  7. datatype label_definition =
  8.     Label_defined of int
  9.   | Label_undefined of (int * int) list
  10. ;
  11.  
  12. val label_table  = ref (Array.fromList [] : label_definition Array.array)
  13. ;
  14.  
  15. fun reset_label_table () =
  16.   label_table := Array.array(16, Label_undefined [])
  17. ;
  18.  
  19. fun extend_label_table needed =
  20.   let val old = Array.length (!label_table)
  21.       val new_table = 
  22.         Array.array((needed div old + 1) * old, Label_undefined [])
  23.   in
  24.     Array.copy { src= !label_table, si=0, len = NONE, dst= new_table, di=0 };
  25.     label_table := new_table
  26.   end;
  27.  
  28. fun define_label lbl =
  29. (
  30.   if lbl < Array.length (!label_table) then () else 
  31.     extend_label_table lbl;
  32.   case Array.sub(!label_table, lbl) of
  33.       Label_defined _ =>
  34.         fatalError "define_label : already defined"
  35.     | Label_undefined L =>
  36.         let val currpos = !out_position in
  37.           Array.update(!label_table, lbl, Label_defined currpos);
  38.           case L of
  39.               [] => ()
  40.             |  _ => 
  41.               (List.app (fn (pos,orig) => 
  42.                            (out_position := pos;
  43.                             out_short (currpos - orig)))
  44.                         L;
  45.                out_position := currpos)
  46.         end
  47. );
  48.  
  49. fun out_label_with_orig orig lbl =
  50. (
  51.   if lbl = Nolabel then 
  52.     fatalError "out_label: undefined label"
  53.   else if lbl >= Array.length (!label_table) then
  54.     extend_label_table lbl
  55.   else ();
  56.   case Array.sub(!label_table, lbl) of
  57.       Label_defined def =>
  58.         out_short (def - orig)
  59.     | Label_undefined L =>
  60.         (Array.update(!label_table, lbl,
  61.            Label_undefined ((!out_position, orig) :: L));
  62.          out_short 0)
  63. );
  64.  
  65. fun out_label l = out_label_with_orig (!out_position) l;
  66.  
  67. end;
  68.